unit HmmProcs;

interface
uses
  Graphics, RSDef, H3MStruct, StdCtrls, Classes, QPix, Grids;

type
  LongIntArray = array of LongInt;

function GetFrame(DefName: AnsiString; Num: Integer): TBitmap;
function GetBitmap(Num: LongInt): TBitmap;
function StrCoords(C: TMapCoords): string;
function GetBit(V, Num: Byte): Boolean;
procedure SetBit(var V: Byte; Num: Byte; Bit: Boolean);
procedure SwitchEnabled(const GrpBx: TGroupBox; Enabled: Boolean);
procedure ErrorMessage(Str1, Str2: WideString);
function RSMixColorsRGBNorm(Color1, Color2: Integer; Percent1: LongWord): TColor;
function RSSwapColor(Value: LongInt): LongInt;
procedure Exchange(var V1, V2: Variant);
function GetGroundPassability(GroundType: Byte): Byte;
procedure DrawOver(Img: TQuickPixels; TP: TTemplatePart; Own: Boolean = True); overload;
procedure DrawOver(Img: TQuickPixels; T: TTemplate); overload;
procedure GridMSort(AGrid: TStringGrid; const SortField: integer);
procedure DeleteFromArray(var Arr: LongIntArray; Index: LongInt);
procedure InsertToArray(var Arr: LongIntArray; Value, Index: LongInt);
procedure AddToArray(var Arr: LongIntArray; Value: LongInt);

implementation
uses
  Main, SysUtils, HmmConsts, Forms;

function GetFrame(DefName: AnsiString; Num: Integer): TBitmap;
var
  TmpDef: TRSDefWrapper;
begin
  H3Sprite.ExtractFile(DefName);
  TmpDef := TRSDefWrapper.Create(H3Sprite.FBuffer);
  Result := TmpDef.ExtractBmp(Num);
end;

function GetBitmap(Num: LongInt): TBitmap;
begin
  H3Bitmap.ExtractFile(Num);
  Result := H3Bitmap.ConvPCXDump2Bitmap;
end;

function StrCoords(C: TMapCoords): string;
begin
  Result := IntToStr(C.X) + ', ' + IntToStr(C.Y) + ', ' + IntToStr(C.L);
end;

function GetBit(V, Num: Byte): Boolean;
begin
  Result := (V and (1 shl Num)) > 0;
end;

procedure SetBit(var V: Byte; Num: Byte; Bit: Boolean);
begin
  if Bit then V := V or (1 shl Num)
  else V := V and not (1 shl Num);
end;

procedure SwitchEnabled(const GrpBx: TGroupBox; Enabled: Boolean);
var
  I: Integer;
begin
  for I := 0 to GrpBx.ControlCount - 1 do
    GrpBx.Controls[I].Enabled := Enabled;
  GrpBx.Enabled := Enabled;
end;

procedure ErrorMessage(Str1, Str2: WideString);
begin
  Application.MessageBox(PWideChar(Str2), PWideChar(Str1));
end;

function RSMixColorsRGBNorm;
var Percent2: LongWord;
begin
  Percent2 := 256 - Percent1;
  LongInt(Result):= (Percent1 * LongWord(Color1 and $ff00) +
            Percent2 * LongWord(Color2 and $ff00)) shr 16 shl 8 or
    (Percent1 * LongWord(Color1 and $ff00ff) +
            Percent2 * LongWord(Color2 and $ff00ff)) and $ff00ff00 shr 8;
end;

function RSSwapColor(Value: LongInt): LongInt;
var
  Tmp: Byte;
begin
  Tmp := PByteArray(@Value)^[2];
  PByteArray(@Value)^[2] := PByteArray(@Value)^[0];
  PByteArray(@Value)^[0] := Tmp;
end;

procedure Exchange(var V1, V2: Variant);
var
  Temp: Variant;
begin
  Temp := V1;
  V1 := V2;
  V2 := Temp;
end;

function GetGroundPassability(GroundType: Byte): Byte;
begin
  case GroundType of
    8: Result := 3;
    9: Result := 5;
  else
    Result := 0;
  end;
end;

procedure DrawOver(Img: TQuickPixels; TP: TTemplatePart; Own: Boolean = True);
var
  PSpecialLine: PByteArray;
  Color, I, J: LongInt;
  Q2: TQuickPixels;
  T: TTemplate;

function SetSelected(Color: Integer): Integer;
var
  R, G, B: Byte;
begin
  R := Color div 65536;
  G := (Color mod 65536) div 256;
  B := (Color mod 256);
  Result := (R + G + B) div 3 shl 16;
end;

begin
    if TP.Template.Reference = nil then T := TP.Template
    else T := TP.Template.Reference;
    Q2 := TQuickPixels.Create(T.Bitmap);
    if Own then Color := Player_Colors[TP.Reference.Owner]
    else Color := Player_Colors[-1];
    for I := 0 to 31 do
      begin
        PSpecialLine := T.Special.ScanLine[TP.Y * 32 + I];
        for J := 0 to 31 do
          case PSpecialLine^[TP.X * 32 + J] of
            255: Img.Pixels[J, I] := {SetSelected(}Q2.Pixels[TP.X * 32 + J, TP.Y * 32 + I]{)};
            1: Img.Pixels[J, I] := RSMixColorsRGBNorm(Img.Pixels[J, I], 0, 182);
            2: Img.Pixels[J, I] := RSMixColorsRGBNorm(Img.Pixels[J, I], 0, 162);
            3: Img.Pixels[J, I] := RSMixColorsRGBNorm(Img.Pixels[J, I], 0, 143);
            4: Img.Pixels[J, I] := RSMixColorsRGBNorm(Img.Pixels[J, I], 0, 124);
            5: Img.Pixels[J, I] := Color;
          end;
      end;
    Q2.Free;
end;

procedure DrawOver(Img: TQuickPixels; T: TTemplate);
var
  PSpecialLine: PByteArray;
  Color, I, J: LongInt;
  Q2: TQuickPixels;
  X, Y: LongInt;
begin
    Q2 := TQuickPixels.Create(T.Bitmap);
    Color := Player_Colors[-1];
    X := T.Bitmap.Width;
    Y := T.Bitmap.Height;
    for I := 0 to Y - 1 do
      begin
        PSpecialLine := T.Special.ScanLine[I];
        for J := 0 to X - 1 do
          case PSpecialLine^[J] of
            255: Img.Pixels[J, I] := Q2.Pixels[J, I];
            1: Img.Pixels[J, I] := RSMixColorsRGBNorm(Img.Pixels[J, I], 0, 182);
            2: Img.Pixels[J, I] := RSMixColorsRGBNorm(Img.Pixels[J, I], 0, 162);
            3: Img.Pixels[J, I] := RSMixColorsRGBNorm(Img.Pixels[J, I], 0, 143);
            4: Img.Pixels[J, I] := RSMixColorsRGBNorm(Img.Pixels[J, I], 0, 124);
            5: Img.Pixels[J, I] := Color;
          end;
      end;
    Q2.Free;
end;

procedure GridMSort(AGrid: TStringGrid; const SortField: integer);

procedure ExchangeItems(Index1, Index2: Integer);
var
  i: integer;
  T: string;
begin
  for i := 0 to AGrid.ColCount - 1 do
  begin
    T := AGrid.Cells[i, Index1];
    AGrid.Cells[i, Index1] := AGrid.Cells[i, Index2];
    AGrid.Cells[i, Index2] := T;
  end;
end;

procedure QuickSort(L, R: integer);
var
  I, J: Integer;
  P: string;
begin
  repeat
    I := L;
    J := R;
    P :=AGrid.Cells[SortField, (L+R) shr 1];
    repeat
      begin
        while CompareText(AnsiUpperCase(AGrid.Cells[SortField, I]),
                           AnsiUpperCase(P)) < 0 do
        Inc(I);
        while CompareText(AnsiUpperCase(AGrid.Cells[SortField, J]),
                          AnsiUpperCase(P)) > 0 do
        Dec(J);
      end;
      if I <= J then
      begin
        ExchangeItems(I, J);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then QuickSort(L, J);
    L := I;
  until I >= R;
end;

begin
if AGrid.RowCount > 1 then QuickSort(1, AGrid.RowCount-1);
end;

procedure DeleteFromArray(var Arr: LongIntArray; Index: LongInt);
var
  I: LongInt;
begin
  for I := Index + 1 to High(Arr) do
    Arr[I - 1] := Arr[I];
  SetLength(Arr, High(Arr));
end;

procedure InsertToArray(var Arr: LongIntArray; Value, Index: LongInt);
var
  I: LongInt;
begin
  SetLength(Arr, High(Arr) + 2);
  Arr[Index] := Value;
  for I := Index to High(Arr) - 1 do
    Arr[I + 1] := Arr[I];
end;

procedure AddToArray(var Arr: LongIntArray; Value: LongInt);
var
  I: LongInt;
begin
  SetLength(Arr, High(Arr) + 2);
  Arr[High(Arr)] := Value;
end;
end.
